home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Bavarian / Bavarian #121 (19xx)(APS Electronic).zip / Bavarian #121 (19xx)(APS Electronic).adf / SuperPRINT (.txt) < prev    next >
AmigaBASIC Source Code  |  1987-05-08  |  14KB  |  525 lines
  1. '======================================
  2. '||       S u p e r P R I N T        ||
  3. '======================================
  4. ' geschrieben von  Michael Grauli
  5. '                  Richener Str. 54
  6. '                  7519 Gemmingen
  7. '--------------------------------------
  8. '  Dieses Programm ist Public Domain,
  9. '  d.h. es darf frei kopiert und
  10. '  und weitergegeben werden !
  11. '--------------------------------------
  12.   DEFLNG a-z : GOSUB Titel
  13.   DECLARE FUNCTION ALLOCMEM     LIBRARY
  14.   DECLARE FUNCTION ALLOCSIGNAL  LIBRARY
  15.   DECLARE FUNCTION FINDTASK     LIBRARY
  16.   DECLARE FUNCTION DOIO         LIBRARY
  17.   DECLARE FUNCTION OPENDEVICE   LIBRARY
  18.   DECLARE FUNCTION OPENSCREEN   LIBRARY
  19.   DECLARE FUNCTION OPENWINDOW   LIBRARY
  20.   DECLARE FUNCTION GETMSG       LIBRARY
  21.   DECLARE FUNCTION READPIXEL    LIBRARY
  22.   DECLARE FUNCTION AVAILFONTS   LIBRARY
  23.   DECLARE FUNCTION OPENFONT     LIBRARY
  24.   DECLARE FUNCTION OPENDISKFONT LIBRARY
  25.   DECLARE FUNCTION TEXTLENGTH   LIBRARY
  26.   LIBRARY "intuition.library"
  27.   LIBRARY "graphics.library"
  28.   LIBRARY "diskfont.library"
  29.   LIBRARY "exec.library"
  30.   DEF FNlongint(ga) = PEEKL(PEEKL(ga+34)+28)
  31.   ON BREAK GOSUB CtrlC : BREAK ON
  32.   GOSUB Init
  33.   GOSUB Fensteran
  34.   GOSUB Abfrage
  35.   GOSUB Fensteraus
  36.   CLOSEMEM fo(0)
  37.   FREEMEM must,6
  38.   LIBRARY CLOSE
  39.   SYSTEM
  40.  
  41. Titel:
  42.   LINE (200,50)-(420,130),1,bf
  43.   LINE (200,50)-(420,130),2,b
  44.   POKE WINDOW(8)+56,2
  45.   POKE WINDOW(8)+28,0 : COLOR 2
  46.   POKEW WINDOW(8)+36,234 : POKEW WINDOW(8)+38,70
  47.   PRINT "S u p e r P R I N T"
  48.   POKEW WINDOW(8)+36,236 : POKEW WINDOW(8)+38,69
  49.   PRINT "S u p e r P R I N T"
  50.   POKEW WINDOW(8)+36,238 : POKEW WINDOW(8)+38,70
  51.   PRINT "S u p e r P R I N T"
  52.   POKEW WINDOW(8)+36,236 : POKEW WINDOW(8)+38,71
  53.   PRINT "S u p e r P R I N T" : COLOR 3
  54.   POKEW WINDOW(8)+36,236 : POKEW WINDOW(8)+38,70
  55.   PRINT "S u p e r P R I N T"
  56.   POKE WINDOW(8)+56,4 : LOCATE 12,27 : COLOR 2
  57.   PRINT "Ein Public-Domain Programm" : LOCATE 14,29
  58.   PRINT "von Michael Grauli 1989"
  59.   RETURN
  60. Init:
  61.   SETWINDOWTITLES WINDOW(7),SADD("Bitte warten ..."+CHR$(0)),0
  62.   DIM fo(20),gr(20,20),ng(60),fole%(20)
  63.   fonts = ALLOCMEM(1000,65537)
  64.   IF fonts = 0 THEN ERROR 7
  65.   e = AVAILFONTS(fonts,1000,3)
  66.   IF e <> 0 THEN ERROR 5
  67.   af = PEEKW(fonts) : nf = 1
  68.   spa5$ = SPACE$(5) : spa20$ = SPACE$(20)
  69.   FOR i = 0 TO af-1
  70.     fo$ = STRING$(20,0)
  71.     add = PEEKL(fonts+i*10+4)
  72.     COPYMEM add,SADD(fo$),20
  73.     fo$ = LEFT$(fo$,INSTR(fo$,CHR$(0))-1)
  74.     fole% = LEN(fo$)
  75.     fo$ = fo$+SPACE$(20-LEN(fo$))
  76.     IF fo$ <> lafo$ THEN
  77.       OPENMEM fo(0),gr(nf,ng(nf)+1),5
  78.       COPYMEM SADD(spa5$),gr(nf,ng(nf)+1),5
  79.       nf = nf+1 : fole%(nf) = fole%
  80.       OPENMEM fo(0),fo(nf),20
  81.       COPYMEM SADD(fo$),fo(nf),20
  82.       lafo$ = fo$
  83.       OPENMEM fo(0),gr(nf,0),5
  84.       COPYMEM SADD(spa5$),gr(nf,0),5
  85.     END IF
  86.     ng(nf) = ng(nf)+1
  87.     gr$ = STR$(PEEKW(fonts+i*10+8))
  88.     gr$ = gr$+SPACE$(5-LEN(gr$))
  89.     OPENMEM fo(0),gr(nf,ng(nf)),5
  90.     COPYMEM SADD(gr$),gr(nf,ng(nf)),5
  91.   NEXT i
  92.   OPENMEM fo(0),fo(1),20
  93.   COPYMEM SADD(spa20$),fo(1),20
  94.   OPENMEM fo(0),fo(nf+1),20
  95.   COPYMEM SADD(spa20$),fo(nf+1),20
  96.   OPENMEM fo(0),gr(nf,ng(nf)+1),5
  97.   COPYMEM SADD(spa5$),gr(nf,ng(nf)+1),5
  98.   FREEMEM fonts,1000
  99.   spa5$ = "" : spa20$ = "" : fo$ = "" : gr$ = ""
  100.   zeif = 2 : zeig = 1
  101.   IF nf = 0 THEN ERROR 5
  102.   must = ALLOCMEM(6,65539)
  103.   IF must = 0 THEN ERROR 7
  104.   POKEW must,&Hffff
  105.   POKEW must+2,&Hcccc
  106.   POKEW must+4,&H3333
  107.   WINDOW CLOSE 1
  108.   prefs = ALLOCMEM(220,65537)
  109.   GETPREFS prefs,220
  110.   POKEW prefs+170,1
  111.   POKEW prefs+172,1
  112.   SETPREFS prefs,220,-1
  113.   FREEMEM prefs,220
  114.   RETURN
  115. CtrlC: RETURN
  116. Textzeigen:
  117.   SETRAST rp2,0
  118.   IF altfo <> zeif OR altgr <> zeig THEN
  119.     altfo$ = STRING$(fole%(zeif),0)
  120.     altgr$ = STRING$(5,0)
  121.     COPYMEM fo(zeif),SADD(altfo$),fole%(zeif)
  122.     COPYMEM gr(zeif,zeig),SADD(altgr$),5
  123.     texta(0) = SADD(altfo$+CHR$(0))
  124.     texta(1) = VAL(altgr$)*65536
  125.     IF zeif = 2 THEN
  126.       neufont = OPENFONT(VARPTR(texta(0)))
  127.     ELSE
  128.       neufont = OPENDISKFONT(VARPTR(texta(0)))
  129.     END IF
  130.     IF neufont = 0 THEN
  131.       zeif = altfo : zeig = altgr
  132.       GOSUB Fontszeigen
  133.       GOSUB Groessenzeigen
  134.     ELSE
  135.       IF font <> 0 THEN CLOSEFONT font
  136.       altfo = zeif : altgr = zeig : font = neufont
  137.       SETFONT rp2,font
  138.     END IF
  139.     baseline = PEEKW(rp2+62)
  140.     fohoehe = PEEKW(rp2+58)
  141.   END IF
  142.   SCREENTOFRONT sc2
  143.   POKEW rp2+64,ABS(FNlongint(ga1(35)))
  144.   IF READPIXEL(rp1,91,66) THEN stil = 1 :ELSE stil = 0
  145.   IF READPIXEL(rp1,231,66) THEN stil = stil+2
  146.   IF READPIXEL(rp1,301,66) THEN stil = stil+4
  147.   IF fohoehe = 16 THEN stil = 0
  148.   POKE rp2+56,stil
  149.   IF READPIXEL(rp1,71,83) THEN out = ABS(FNlongint(ga1(15))) :ELSE out = 0
  150.   ax% = out+1 : ay% = baseline+out+1
  151.   IF stil AND 4 THEN ax% = ax%+fohoehe\8
  152.   READSTR ga1(41),tex$
  153.   le = TEXTLENGTH(rp2,SADD(tex$),LEN(tex$))
  154.   IF le = 0 THEN RETURN
  155.   mx% = ax% : my% = ay% : d3pu = 0
  156.   IF READPIXEL(rp1,71,117) THEN
  157.     d3pu = ABS(FNlongint(ga1(29)))
  158.     mx% = ax%+d3pu : my% = ay%+d3pu
  159.   END IF
  160.   sx% = mx% : sy% = my% : schapu = 0
  161.   IF READPIXEL(rp1,71,100) THEN
  162.     schapu = ABS(FNlongint(ga1(22)))
  163.     sx% = mx%+schapu : sy% = my%+schapu
  164.   END IF
  165.   maxx% = sx%+le+out : maxy% = sy%+fohoehe-baseline+out
  166.   IF stil AND 2 THEN maxx% = maxx%+1
  167.   IF stil AND 4 THEN maxx% = maxx%+fohoehe\2.5
  168.   SETAPEN rp2,1 : RECTFILL rp2,0,0,maxx%,maxy%
  169.   IF schapu > 0 THEN OUTLINE rp2,sx%,sy%,tex$,out,28-schattfa
  170.   IF d3pu > 0 THEN
  171.     FOR i = 0 TO d3pu-1
  172.       dx% = mx%-i : dy% = my%-i
  173.       OUTLINE rp2,dx%,dy%,tex$,out,35-d3fa
  174.     NEXT i
  175.   END IF
  176.   IF out THEN OUTLINE rp2,ax%,ay%,tex$,out,21-outfa
  177.   OUTLINE rp2,ax%,ay%,tex$,0,41-schrifa
  178.   RETURN
  179. Abfrage:
  180.   mp = PEEKL(wi1+86)
  181.   WHILE a = 0
  182.     WHILE me = 0
  183.       me = GETMSG(mp)
  184.     WEND
  185.     READMSG me
  186.     IF class = 64 THEN
  187.       IF gadid = 4 THEN
  188.         IF zeif > 2 THEN
  189.           zeif = zeif-1 : zeig = 1
  190.           GOSUB Fontszeigen
  191.           GOSUB Groessenzeigen
  192.         END IF
  193.       ELSEIF gadid = 5 THEN
  194.         IF zeif < nf THEN
  195.           zeif = zeif+1 : zeig = 1
  196.           GOSUB Fontszeigen
  197.           GOSUB Groessenzeigen
  198.         END IF
  199.       ELSEIF gadid = 9 THEN
  200.         IF zeig > 1 THEN zeig = zeig-1 : GOSUB Groessenzeigen
  201.       ELSEIF gadid = 10 THEN
  202.         IF zeig < ng(zeif) THEN zeig = zeig+1 : GOSUB Groessenzeigen
  203.       ELSEIF gadid = 15 THEN
  204.         ACTIVATEGADGET ga1(22),wi1,0
  205.       ELSEIF gadid = 22 THEN
  206.         ACTIVATEGADGET ga1(29),wi1,0
  207.       ELSEIF gadid = 29 THEN
  208.         ACTIVATEGADGET ga1(35),wi1,0
  209.       ELSEIF gadid = 35 THEN
  210.         ACTIVATEGADGET ga1(41),wi1,0
  211.       ELSEIF gadid = 42 THEN
  212.         ACTIVATEGADGET ga1(43),wi1,0
  213.       ELSEIF gadid = 45 THEN
  214.         GOSUB Textzeigen
  215.         IF le = 0 THEN RETURN
  216.         IF maxx% > 319 THEN maxx% = 319
  217.         IF maxy% > 79 THEN maxy% = 79
  218.         sbreit% = FNlongint(ga1(42))
  219.         shoch% = FNlongint(ga1(43))
  220.         IF sbreit% < 1 THEN sbreit% = 1
  221.         IF shoch% < 1 THEN shoch% = 1
  222.         SETRGB4 vp,3,7,7,7
  223.         SETRGB4 vp,4,3,3,3
  224.         PRT rp2,0,0,maxx%+1,maxy%+1,sbreit%,shoch%,1
  225.         SETRGB4 vp,4,5,5,5
  226.         SETRGB4 vp,3,9,9,9
  227.         SCREENTOFRONT sc2
  228.       ELSE
  229.         GOSUB Textzeigen
  230.       END IF
  231.     ELSEIF class = 32 THEN
  232.       IF gadid > 15 AND gadid < 21 THEN
  233.         GADGETGROUP rp1,ga1(),outfa,gadid
  234.       ELSEIF gadid > 22 AND gadid < 28 THEN
  235.         GADGETGROUP rp1,ga1(),schattfa,gadid
  236.       ELSEIF gadid > 29 AND gadid < 35 THEN
  237.         GADGETGROUP rp1,ga1(),d3fa,gadid
  238.       ELSE
  239.         GADGETGROUP rp1,ga1(),schrifa,gadid
  240.       END IF
  241.     ELSE
  242.       a = 1
  243.     END IF
  244.   WEND : a = 0
  245.   RETURN
  246. Fontszeigen:
  247.   SETAPEN rp1,2 : SETBPEN rp1,3
  248.   MOVE rp1,142,40 : TEXT rp1,fo(zeif),20
  249.   SETAPEN rp1,1 : SETBPEN rp1,0
  250.   MOVE rp1,142,29 : TEXT rp1,fo(zeif-1),20
  251.   MOVE rp1,142,51 : TEXT rp1,fo(zeif+1),20
  252.   RETURN
  253. Groessenzeigen:
  254.   SETAPEN rp1,2 : SETBPEN rp1,3
  255.   MOVE rp1,422,40 : TEXT rp1,gr(zeif,zeig),5
  256.   SETAPEN rp1,1 : SETBPEN rp1,0
  257.   MOVE rp1,422,29 : TEXT rp1,gr(zeif,zeig-1),5
  258.   MOVE rp1,422,51 : TEXT rp1,gr(zeif,zeig+1),5
  259.   RETURN
  260. Fensteran:
  261.   NEWSCREEN sc2,"",320,80,3,0
  262.   NEWWINDOW wi2,"",0,0,320,80,67584,0,sc2
  263.   vp = sc2+44 : rp2 = PEEKL(wi2+50)
  264.   SETRGB4 vp,1,15,15,15
  265.   SETRGB4 vp,2,13,13,13
  266.   SETRGB4 vp,3,9,9,9
  267.   SETRGB4 vp,4,5,5,5
  268.   SETRGB4 vp,5,0,0,0
  269.   SETDRMD rp2,0
  270.   MOVESCREEN sc2,0,203
  271.   DIM ga1(50)
  272.   GADGET ga1(),140,20,164,12,"",0
  273.   GADGET ga1(),140,31,164,12,"Zeichensatz :"+SPACE$(38),0
  274.   GADGET ga1(),140,42,164,12,"",0
  275.   GADGET ga1(),320,20,20,12,"/\",1
  276.   GADGET ga1(),320,42,20,12,"\/",1
  277.   GADGET ga1(),420,20,84,12,"",0
  278.   GADGET ga1(),420,31,84,12,"Höhe :"+SPACE$(20),0
  279.   GADGET ga1(),420,42,84,12,"",0
  280.   GADGET ga1(),520,20,20,12,"/\",1
  281.   GADGET ga1(),520,42,20,12,"\/",1
  282.   GADGET ga1(),90,65,120,12,"Stil :    Unterstrichen"+SPACE$(10),256
  283.   GADGET ga1(),230,65,50,12,"Fett",256
  284.   GADGET ga1(),300,65,70,12,"Kursiv",256
  285.   GADGET ga1(),70,82,70,12,"Outline",256
  286.   GADGET ga1(),170,82,28,12,SPACE$(12)+"Punkte",2049
  287.   GADGETSTR ga1(),15,MKL$(1),3
  288.   GADGET ga1(),420,82,24,12,"Outlinefarbe :"+SPACE$(23),2
  289.   FOR x% = 460 TO 580 STEP 40
  290.     GADGET ga1(),x%,82,24,12,"",2
  291.   NEXT x%
  292.   GADGET ga1(),70,99,70,12,"Schatten",256
  293.   GADGET ga1(),170,99,28,12,SPACE$(12)+"Punkte",2049
  294.   GADGETSTR ga1(),22,MKL$(2),3
  295.   GADGET ga1(),420,99,24,12,"Schattenfarbe :"+SPACE$(22),2
  296.   FOR x% = 460 TO 580 STEP 40
  297.     GADGET ga1(),x%,99,24,12,"",2
  298.   NEXT x%
  299.   GADGET ga1(),70,116,70,12,"3-D",256
  300.   GADGET ga1(),170,116,28,12,SPACE$(12)+"Punkte",2049
  301.   GADGETSTR ga1(),29,MKL$(4),3
  302.   GADGET ga1(),420,116,24,12,"3-D Farbe :"+SPACE$(26),2
  303.   FOR x% = 460 TO 580 STEP 40
  304.     GADGET ga1(),x%,116,24,12,"",2
  305.   NEXT x%
  306.   GADGET ga1(),170,133,28,12,"Zeichenabstand :"+SPACE$(8)+"Punkte"+SPACE$(12),2049
  307.   GADGETSTR ga1(),35,MKL$(0),3
  308.   GADGET ga1(),420,133,24,12,"Schriftfarbe :"+SPACE$(23),2
  309.   FOR x% = 460 TO 580 STEP 40
  310.     GADGET ga1(),x%,133,24,12,"",2
  311.   NEXT x%
  312.   GADGET ga1(),90,155,280,12,"Text :"+SPACE$(47),1
  313.   GADGETSTR ga1(),41,"",34
  314.   GADGET ga1(),110,177,28,12,"  Drucken :"+SPACE$(7)+"Seiten breit",2049
  315.   GADGETSTR ga1(),42,MKL$(1),2
  316.   GADGET ga1(),270,177,44,12,SPACE$(12)+"1/    Seite hoch",3072
  317.   GADGETSTR ga1(),43,MKL$(1),2
  318.   GADGET ga1(),420,155,90,34,"Zeigen",1
  319.   GADGET ga1(),530,155,90,34,"Drucken",1
  320.   ga=ga1(1)
  321.   NEWWINDOW wi1,"SuperPRINT",0,0,640,200,69646,608,0
  322.   SCREENTOFRONT sc2
  323.   tit = ALLOCMEM(11,65537)
  324.   t = PEEKL(wi1+32) : COPYMEM t,tit,10
  325.   POKEL wi1+32,tit : rp1 = PEEKL(wi1+50)
  326.   POKEL rp1+8,must : POKE rp1+29,1
  327.   SETAPEN rp1,2 : SETBPEN rp1,2
  328.   FOR x% = 421 TO 581 STEP 40
  329.     IF x% = 461 THEN SETBPEN rp1,1
  330.     IF x% = 501 THEN POKEL rp1+8,must+2
  331.     IF x% = 541 THEN POKEL rp1+8,must : SETAPEN rp1,1 : SETBPEN rp1,2 
  332.     IF x% = 581 THEN SETBPEN rp1,1
  333.     FOR y% = 83 TO 134 STEP 17
  334.       RECTFILL rp1,x%,y%,x%+21,y%+9
  335.   NEXT y%,x% 
  336.   POKEL rp1+8,0 : POKE rp1+29,0
  337.   SETAPEN rp1,3
  338.   RECTFILL rp1,141,32,302,41
  339.   RECTFILL rp1,421,32,502,41
  340.   GOSUB Fontszeigen
  341.   GOSUB Groessenzeigen
  342.   GADGETGROUP rp1,ga1(),19,0 : outfa = 19
  343.   GADGETGROUP rp1,ga1(),25,0 : schattfa = 25
  344.   GADGETGROUP rp1,ga1(),31,0 : d3fa = 31
  345.   GADGETGROUP rp1,ga1(),36,0 : schrifa = 36
  346.   ACTIVATEGADGET ga1(41),wi1,0
  347.   RETURN
  348. Fensteraus:
  349.   IF font <> 0 THEN CLOSEFONT font : font = 0
  350.   CLOSEWINDOW wi2
  351.   CLOSESCREEN sc2
  352.   CLOSEWINDOW wi1
  353.   CLOSEMEM ga1(0)
  354.   RETURN
  355.  
  356. SUB PRT (rp,x%,y%,b%,h%,db%,dh%,sp%) STATIC
  357.   SHARED vp : cm = PEEKL(vp+4)
  358.   vm% = PEEKW(vp+32) : bit =  ALLOCSIGNAL(-1)
  359.   po = ALLOCMEM(40,65537) : IF po = 0 THEN ERROR 7
  360.   t = FINDTASK(0) : t$ = "PRT"+CHR$(0)
  361.   POKE po+8,4 : POKEL po+10,SADD(t$)
  362.   POKE po+15,bit : POKEL po+16,t
  363.   ADDPORT po : r = ALLOCMEM(64,65537)
  364.   IF r = 0 THEN ERROR 7
  365.   POKE r+8,5 : POKE r+9,0 : POKEL r+14,po
  366.   d$ = "printer.device"+CHR$(0)
  367.   e = OPENDEVICE&(SADD(d$),0,r,0)
  368.   IF e <> 0 THEN 1
  369.   IF sp% = 1 THEN
  370.     da = PEEKL(PEEKL(r+20)+92)+12
  371.     dh = PEEKL(da+26)/dh%
  372.     db = (PEEKW(da+36)*11)*db%
  373.   END IF
  374.   POKEW r+28,11 : POKEL r+32,rp
  375.   POKEL r+36,cm : POKEL r+40,vm
  376.   POKEW r+44,x% : POKEW r+46,y%
  377.   POKEW r+48,b% : POKEW r+50,h%
  378.   POKEL r+52,db : POKEL r+56,dh
  379.   e = DOIO(r)
  380.   CLOSEDEVICE r : POKE r+8,&Hff
  381.   POKEL r+20,-1 : POKEL r+24,-1
  382. 1 FREEMEM r,64 : REMPORT po
  383.   POKE po+8,&Hff : POKEL po+20,-1
  384.   FREESIGNAL bit : FREEMEM po,40
  385. END SUB   
  386. SUB READMSG (me) STATIC
  387.   SHARED class,code%
  388.   SHARED menuid,itemid,subid
  389.   SHARED gadid
  390.   class = PEEKL(me+20)    
  391.   code% = PEEKW(me+24) 
  392.   IF class = 256 THEN
  393.     menuid = (code% AND 31)
  394.     itemid = (code% AND 992)\32
  395.     subid  = (code% AND 31744)\2048
  396.   ELSEIF class = 32 OR class = 64 THEN
  397.     gadid = PEEKW(PEEKL(me+28)+38)
  398.   END IF
  399.   REPLYMSG me : me = 0
  400. END SUB
  401. SUB GADGET (ga(),x%,y%,b%,h%,t$,a%) STATIC
  402.   lg = ga(UBOUND(ga))
  403.   OPENMEM ga(0),ga,105+LEN(t$)
  404.   IF lg = 0 THEN n% = 1 :ELSE n% = PEEKW(lg+38)+1
  405.   POKEW ga,-1      : POKEW ga+2,-1
  406.   POKE  ga+4,1     : POKE  ga+7,5
  407.   POKEL ga+8,ga+20 : POKEW ga+24,b%-1
  408.   POKEW ga+28,b%-1 : POKEW ga+30,h%-1
  409.   POKEW ga+34,h%-1 : POKE  ga+40,1
  410.   POKEW ga+44,(b%-LEN(t$)*8+1)\2-1
  411.   POKEW ga+46,(h%+1)\2-5
  412.   POKEL ga+52,ga+104 : COPYMEM SADD(t$),ga+104,LEN(t$)
  413.   POKEW ga+64,x%+1 : POKEW ga+66,y%+1
  414.   POKEW ga+68,b%-2 : POKEW ga+70,h%-2
  415.   POKEW ga+74,a%    : POKEW ga+76,1
  416.   POKEL ga+78,ga   : POKEL ga+86,ga+40
  417.   POKEW ga+98,n%   : ga(n%) = ga+60
  418.   IF lg <> 0 THEN POKEL lg,ga(n%)
  419.   ga(UBOUND(ga)) = ga(n%)
  420. END SUB
  421. SUB GADGETSTR (ga(),n%,t$,l%) STATIC
  422.   ga = ga(n%) : bo = PEEKL(ga+18)
  423.   OPENMEM ga(0),sp,40+l%*2
  424.   POKEW bo,-2 : POKEW bo+2,-2  
  425.   POKEW ga+4,PEEKW(ga+4)+1
  426.   POKEW ga+6,PEEKW(ga+6)+1
  427.   POKEW ga+8,PEEKW(ga+8)-2
  428.   POKEW ga+10,8  : POKEW ga+16,4
  429.   POKEL ga+34,sp : POKEL sp,sp+36
  430.   POKEL sp+4,sp+38+l% : POKEW sp+10,l%
  431.   IF PEEKW(ga+14) AND 2048 THEN
  432.     i = CVL(t$) : POKEL sp+28,i
  433.     t$ = RIGHT$(STR$(i),LEN(STR$(i))-1)
  434.   END IF
  435.   COPYMEM SADD(t$),sp+36,LEN(t$)
  436.   POKEW sp+8,LEN(t$)
  437. END SUB
  438. SUB READSTR (ga,t$) STATIC
  439.   sp = PEEKL(ga+34)
  440.   l = PEEKW(sp+16) : t$ = STRING$(l,0)
  441.   COPYMEM sp+36,SADD(t$),l
  442. END SUB
  443. SUB NEWSCREEN (sc,t$,b%,h%,t%,m) STATIC
  444.   SHARED bi
  445.   ns = ALLOCMEM(32,65537)
  446.   IF ns = 0 THEN ERROR 7
  447.   POKEW ns+4,b% : POKEW ns+6,h%
  448.   POKEW ns+8,t% : POKE ns+10,2
  449.   POKE ns+11,1  : POKEW ns+12,m
  450.   POKEW ns+14,143 : POKEL ns+28,bi
  451.   IF bi <> 0 THEN POKEW ns+14,207
  452.   POKEL ns+20,SADD(t$+CHR$(0))
  453.   sc = OPENSCREEN(ns)
  454.   IF sc = 0 THEN ERROR 5
  455.   FREEMEM ns,32
  456. END SUB
  457. SUB NEWWINDOW (wi,t$,x%,y%,b%,h%,f,i,sc) STATIC
  458.   SHARED ga
  459.   nw = ALLOCMEM(48,65537)
  460.   IF nw = 0 THEN ERROR 7
  461.   POKEW nw,x%   : POKEW nw+2,y%
  462.   POKEW nw+4,b% : POKEW nw+6,h%
  463.   POKE nw+8,2   : POKE nw+9,1
  464.   POKEL nw+10,i : POKEL nw+14,f
  465.   POKEL nw+18,ga : POKEL nw+30,sc
  466.   POKEL nw+26,SADD(t$+CHR$(0))
  467.   IF t$ = "" THEN POKEL nw+26,0
  468.   IF sc = 0 THEN t = 1 :ELSE t = 15
  469.   POKEW nw+38,90 : POKEW nw+40,40
  470.   POKEW nw+42,-1 : POKEW nw+44,-1
  471.   POKEW nw+46,t
  472.   wi = OPENWINDOW(nw)
  473.   IF wi = 0 THEN ERROR 5
  474.   FREEMEM nw,48
  475. END SUB
  476. SUB BOX (rp,x1%,y1%,x2%,y2%) STATIC
  477.   a%(0) = x2% : a%(1) = y1%
  478.   a%(2) = x2% : a%(3) = y2%
  479.   a%(4) = x1% : a%(5) = y2%
  480.   a%(6) = x1% : a%(7) = y1%
  481.   MOVE rp,x1%+1,y1%
  482.   POLYDRAW rp,4,VARPTR(a%(0))
  483. END SUB
  484. SUB GADGETGROUP (rp,ga(),n,gadid) STATIC
  485.   SETDRMD rp,2
  486.   IF gadid > 0 THEN
  487.     x% = PEEKW(ga(gadid)+4) : y% = PEEKW(ga(gadid)+6)
  488.     BOX rp,x%-5,y%-3,x%+PEEKW(ga(gadid)+8)+4,y%+PEEKW(ga(gadid)+10)+2
  489.     SWAP n,gadid
  490.   ELSE
  491.     gadid = n
  492.   END IF
  493.   x% = PEEKW(ga(gadid)+4) : y% = PEEKW(ga(gadid)+6)
  494.   BOX rp,x%-5,y%-3,x%+PEEKW(ga(gadid)+8)+4,y%+PEEKW(ga(gadid)+10)+2
  495.   SETDRMD rp,1
  496. END SUB
  497. SUB OPENMEM (li,mem,le%) STATIC
  498.   mem = ALLOCMEM(le%+8,65537)
  499.   IF mem = 0 THEN ERROR 7
  500.   POKEL mem,li
  501.   POKEL mem+4,le%+8
  502.   li = mem : mem = mem+8
  503. END SUB
  504. SUB CLOSEMEM (li) STATIC
  505.   WHILE li <> 0
  506.     mem = PEEKL(li)
  507.     le = PEEKL(li+4)
  508.     FREEMEM li,le : li = mem
  509.   WEND
  510. END SUB
  511. SUB OUTLINE (rp,x%,y%,t$,out,f) STATIC
  512.   SETAPEN rp,f
  513.   IF out = 0 THEN
  514.     MOVE rp,x%,y%
  515.     TEXT rp,SADD(t$),LEN(t$)
  516.   ELSE
  517.     FOR j = 1 TO out
  518.       FOR i! = 0 TO 6.3 STEP 1.57/j^2
  519.         x = SIN(i!)*j+x% : y = COS(i!)*j+y%
  520.         MOVE rp,x,y : TEXT rp,SADD(t$),LEN(t$)
  521.     NEXT i!,j
  522.   END IF
  523. END SUB
  524.  
  525.